home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 001 / pibcalc.arc / READLINE.PAS < prev    next >
Pascal/Delphi Source File  |  1985-03-09  |  5KB  |  118 lines
  1. (*--------------------------------------------------------------------------*)
  2. (*                  ReadLine -- Read PibCalc command line                   *)
  3. (*--------------------------------------------------------------------------*)
  4.  
  5. PROCEDURE ReadLine;
  6.  
  7. (*--------------------------------------------------------------------------*)
  8. (*                                                                          *)
  9. (*     Procedure: ReadLine                                                  *)
  10. (*                                                                          *)
  11. (*     Purpose:   Reads PibCalc command line                                *)
  12. (*                                                                          *)
  13. (*     Calling sequence:                                                    *)
  14. (*                                                                          *)
  15. (*        ReadLine;                                                         *)
  16. (*                                                                          *)
  17. (*     Calls:                                                               *)
  18. (*                                                                          *)
  19. (*        TextColor                                                         *)
  20. (*        UpCase                                                            *)
  21. (*        COPY                                                              *)
  22. (*                                                                          *)
  23. (*     Called by:                                                           *)
  24. (*                                                                          *)
  25. (*        PibCalc (Main program)                                            *)
  26. (*                                                                          *)
  27. (*--------------------------------------------------------------------------*)
  28.  
  29. LABEL
  30.    1, 99;
  31.  
  32. VAR
  33.    c: CHAR;
  34.  
  35. BEGIN (* Readline *)
  36.  
  37.                                    (* Check if we have edited line to *)
  38.                                    (* be used as command line. If so, *)
  39.                                    (* skip command line read.         *)
  40.  
  41.    IF UseEdit THEN
  42.       BEGIN
  43.          Iline   := Oline;
  44.          UseEdit := FALSE;
  45.          Ipos    := 1;
  46.          GOTO 99;
  47.       END;
  48.  
  49.                                    (* Save previous command line      *)
  50.    Oline := Iline;
  51.                                    (* Prompt for input                *)
  52. 1: TEXTCOLOR( Prompt_Color );
  53.    WRITE('? ');
  54.    TEXTCOLOR( ForeGround_Color );
  55.  
  56.                                    (* Initialize input Iline to null  *)
  57.                                    (* Ipos used globally as current   *)
  58.                                    (* position in in Iline            *)
  59.    Ipos  := 0;
  60.    Iline := '';
  61.                                    (* Get first character in line     *)
  62.    READ( c );
  63.                                    (* Loop over input                 *)
  64.  
  65.    WHILE ( Ipos < ( Maxstrlen - 1 ) ) AND ( NOT EOLN ) DO
  66.       BEGIN
  67.                                    (* Ctrl-x is line-delete char.     *)
  68.          IF c = Ctrlx THEN
  69.             BEGIN
  70.                WRITE(' *** DELETED');
  71.                WRITELN;
  72.                GOTO 1;
  73.             END                    (* Back up in line if backspace    *)
  74.          ELSE IF c = bs THEN
  75.             IF Ipos > 0 THEN
  76.                BEGIN
  77.                   Ipos  := Ipos - 1;
  78.                   WRITE(bs,' ',bs);
  79.                   IF Ipos > 0 THEN Iline := COPY( Iline, 1, Ipos );
  80.                END
  81.             ELSE
  82.                BEGIN
  83.                   Ipos  := 0;
  84.                   Iline := '';
  85.                END
  86.          ELSE                      (* Ordinary character -- convert to *)
  87.                                    (* upper case and append to Iline.  *)
  88.            BEGIN
  89.               Ipos  := Ipos + 1;
  90.               IF c IN ['a'..'z'] THEN c := UPCASE( c );
  91.               Iline := Iline + c;
  92.            END;
  93.                                    (* Get next character               *)
  94.          READ( c );
  95.  
  96.      END;
  97.                                    (* Add end-of-string marker COL and *)
  98.                                    (* reset Ipos to 1 = start of Iline *)
  99.    Iline := Iline + COL;
  100.    Ipos  := 1;
  101.  
  102. 99:
  103. END  (* Readline *);
  104.  
  105. (*--------------------------------------------------------------------------*)
  106. (*                 CheckEol -- Check for end-of-command-line                *)
  107. (*--------------------------------------------------------------------------*)
  108.  
  109. PROCEDURE CheckEol;
  110.  
  111. BEGIN  (* CheckEol *)
  112.  
  113.    NextTok;
  114.  
  115.    IF Token <> eolsy THEN SynErr;
  116.  
  117. END    (* CheckEol *);
  118.